home *** CD-ROM | disk | FTP | other *** search
/ HAKERIS 11 / HAKERIS 11.ISO / linux / system / LinuxConsole 0.4 / linuxconsole0.4install-en.iso / guile0.4.lcm / share / guile / 1.6.0 / ice-9 / streams.scm < prev    next >
Encoding:
Text File  |  2004-01-06  |  8.6 KB  |  243 lines
  1. ;;;; streams.scm --- general lazy streams
  2. ;;;; -*- Scheme -*-
  3.  
  4. ;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc.
  5. ;;;; 
  6. ;;;; This program is free software; you can redistribute it and/or modify
  7. ;;;; it under the terms of the GNU General Public License as published by
  8. ;;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;;; any later version.
  10. ;;;; 
  11. ;;;; This program is distributed in the hope that it will be useful,
  12. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;;; GNU General Public License for more details.
  15. ;;;; 
  16. ;;;; You should have received a copy of the GNU General Public License
  17. ;;;; along with this software; see the file COPYING.  If not, write to
  18. ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  19. ;;;; Boston, MA 02111-1307 USA
  20. ;;;;
  21. ;;;; As a special exception, the Free Software Foundation gives permission
  22. ;;;; for additional uses of the text contained in its release of GUILE.
  23. ;;;;
  24. ;;;; The exception is that, if you link the GUILE library with other files
  25. ;;;; to produce an executable, this does not by itself cause the
  26. ;;;; resulting executable to be covered by the GNU General Public License.
  27. ;;;; Your use of that executable is in no way restricted on account of
  28. ;;;; linking the GUILE library code into it.
  29. ;;;;
  30. ;;;; This exception does not however invalidate any other reasons why
  31. ;;;; the executable file might be covered by the GNU General Public License.
  32. ;;;;
  33. ;;;; This exception applies only to the code released by the
  34. ;;;; Free Software Foundation under the name GUILE.  If you copy
  35. ;;;; code from other Free Software Foundation releases into a copy of
  36. ;;;; GUILE, as the General Public License permits, the exception does
  37. ;;;; not apply to the code that you add in this way.  To avoid misleading
  38. ;;;; anyone as to the status of such modified files, you must delete
  39. ;;;; this exception notice from them.
  40. ;;;;
  41. ;;;; If you write modifications of your own for GUILE, it is your choice
  42. ;;;; whether to permit this exception to apply to your modifications.
  43. ;;;; If you do not wish that, delete this exception notice.
  44.  
  45. ;; the basic stream operations are inspired by
  46. ;; (i.e. ripped off) Scheme48's `stream' package,
  47. ;; modulo stream-empty? -> stream-null? renaming.
  48.  
  49. (define-module (ice-9 streams)
  50.   :export (make-stream
  51.        stream-car stream-cdr stream-null?
  52.        list->stream vector->stream port->stream
  53.        stream->list stream->reversed-list
  54.        stream->list&length stream->reversed-list&length
  55.        stream->vector
  56.        stream-fold stream-for-each stream-map))
  57.  
  58. ;; Use:
  59. ;;
  60. ;; (make-stream producer initial-state)
  61. ;;  - PRODUCER is a function of one argument, the current state.
  62. ;;    it should return either a pair or an atom (i.e. anything that
  63. ;;    is not a pair).  if PRODUCER returns a pair, then the car of the pair
  64. ;;    is the stream's head value, and the cdr is the state to be fed
  65. ;;    to PRODUCER later.  if PRODUCER returns an atom, then the stream is
  66. ;;    considered depleted.
  67. ;;
  68. ;; (stream-car stream)
  69. ;; (stream-cdr stream)
  70. ;; (stream-null? stream)
  71. ;;  - yes.
  72. ;;
  73. ;; (list->stream list)
  74. ;; (vector->stream vector)
  75. ;;  - make a stream with the same contents as LIST/VECTOR.
  76. ;;
  77. ;; (port->stream port read)
  78. ;;  - makes a stream of values which are obtained by READing from PORT.
  79. ;;
  80. ;; (stream->list stream)
  81. ;;  - returns a list with the same contents as STREAM.
  82. ;;
  83. ;; (stream->reversed-list stream)
  84. ;;  - as above, except the contents are in reversed order.
  85. ;;
  86. ;; (stream->list&length stream)
  87. ;; (stream->reversed-list&length stream)
  88. ;;  - multiple-valued versions of the above two, the second value is the
  89. ;;    length of the resulting list (so you get it for free).
  90. ;;
  91. ;; (stream->vector stream)
  92. ;;  - yes.
  93. ;;
  94. ;; (stream-fold proc init stream0 ...)
  95. ;;  - PROC must take (+ 1 <number-of-stream-arguments>) arguments, like this:
  96. ;;    (PROC car0 ... init).  *NOTE*: the INIT argument is last, not first.
  97. ;;    I don't have any preference either way, but it's consistent with
  98. ;;    `fold[lr]' procedures from SRFI-1.  PROC is applied to successive
  99. ;;    elements of the given STREAM(s) and to the value of the previous
  100. ;;    invocation (INIT on the first invocation).  the last result from PROC
  101. ;;    is returned.
  102. ;;
  103. ;; (stream-for-each proc stream0 ...)
  104. ;;  - like `for-each' we all know and love.
  105. ;;
  106. ;; (stream-map proc stream0 ...)
  107. ;;  - like `map', except returns a stream of results, and not a list.
  108.  
  109. ;; Code:
  110.  
  111. (define (make-stream m state)
  112.   (delay
  113.     (let ((o (m state)))
  114.       (if (pair? o)
  115.       (cons (car o)
  116.         (make-stream m (cdr o)))
  117.           '()))))
  118.  
  119. (define (stream-car stream)
  120.   "Returns the first element in STREAM.  This is equivalent to `car'."
  121.   (car (force stream)))
  122.  
  123. (define (stream-cdr stream)
  124.   "Returns the first tail of STREAM. Equivalent to `(force (cdr STREAM))'."
  125.   (cdr (force stream)))
  126.  
  127. (define (stream-null? stream)
  128.   "Returns `#t' if STREAM is the end-of-stream marker; otherwise
  129. returns `#f'.  This is equivalent to `null?', but should be used
  130. whenever testing for the end of a stream."
  131.   (null? (force stream)))
  132.  
  133. (define (list->stream l)
  134.   "Returns a newly allocated stream whose elements are the elements of
  135. LIST.  Equivalent to `(apply stream LIST)'."
  136.   (make-stream
  137.    (lambda (l) l)
  138.    l))
  139.  
  140. (define (vector->stream v)
  141.   (make-stream
  142.    (let ((len (vector-length v)))
  143.      (lambda (i)
  144.        (or (= i len)
  145.            (cons (vector-ref v i) (+ 1 i)))))
  146.    0))
  147.  
  148. (define (stream->reversed-list&length stream)
  149.   (let loop ((s stream) (acc '()) (len 0))
  150.     (if (stream-null? s)
  151.         (values acc len)
  152.         (loop (stream-cdr s) (cons (stream-car s) acc) (+ 1 len)))))
  153.  
  154. (define (stream->reversed-list stream)
  155.   (call-with-values
  156.    (lambda () (stream->reversed-list&length stream))
  157.    (lambda (l len) l)))
  158.  
  159. (define (stream->list&length stream)
  160.   (call-with-values
  161.    (lambda () (stream->reversed-list&length stream))
  162.    (lambda (l len) (values (reverse! l) len))))
  163.  
  164. (define (stream->list stream)
  165.   "Returns a newly allocated list whose elements are the elements of STREAM.
  166. If STREAM has infinite length this procedure will not terminate."
  167.   (reverse! (stream->reversed-list stream)))
  168.  
  169. (define (stream->vector stream)
  170.   (call-with-values
  171.    (lambda () (stream->reversed-list&length stream))
  172.    (lambda (l len)
  173.      (let ((v (make-vector len)))
  174.        (let loop ((i 0) (l l))
  175.          (if (not (null? l))
  176.              (begin
  177.                (vector-set! v (- len i 1) (car l))
  178.                (loop (+ 1 i) (cdr l)))))
  179.        v))))
  180.  
  181. (define (stream-fold f init stream . rest)
  182.   (if (null? rest) ;fast path
  183.       (stream-fold-one f init stream)
  184.       (stream-fold-many f init (cons stream rest))))
  185.  
  186. (define (stream-fold-one f r stream)
  187.   (if (stream-null? stream)
  188.       r
  189.       (stream-fold-one f (f (stream-car stream) r) (stream-cdr stream))))
  190.  
  191. (define (stream-fold-many f r streams)
  192.   (if (or-map stream-null? streams)
  193.       r
  194.       (stream-fold-many f
  195.                         (apply f (let recur ((cars
  196.                                               (map stream-car streams)))
  197.                                    (if (null? cars)
  198.                                        (list r)
  199.                                        (cons (car cars)
  200.                                              (recur (cdr cars))))))
  201.                         (map stream-cdr streams))))
  202.  
  203. (define (stream-for-each f stream . rest)
  204.   (if (null? rest) ;fast path
  205.       (stream-for-each-one f stream)
  206.       (stream-for-each-many f (cons stream rest))))
  207.  
  208. (define (stream-for-each-one f stream)
  209.   (if (not (stream-null? stream))
  210.       (begin
  211.         (f (stream-car stream))
  212.         (stream-for-each-one f (stream-cdr stream)))))
  213.  
  214. (define (stream-for-each-many f streams)
  215.   (if (not (or-map stream-null? streams))
  216.       (begin
  217.         (apply f (map stream-car streams))
  218.         (stream-for-each-one f (map stream-cdr streams)))))
  219.  
  220. (define (stream-map f stream . rest)
  221.   "Returns a newly allocated stream, each element being the result of
  222. invoking F with the corresponding elements of the STREAMs
  223. as its arguments."
  224.   (if (null? rest) ;fast path
  225.       (make-stream (lambda (s)
  226.                      (or (stream-null? s)
  227.                          (cons (f (stream-car s)) (stream-cdr s))))
  228.                    stream)
  229.       (make-stream (lambda (streams)
  230.                      (or (or-map stream-null? streams)
  231.                          (cons (apply f (map stream-car streams))
  232.                                (map stream-cdr streams))))
  233.                    (cons stream rest))))
  234.  
  235. (define (port->stream port read)
  236.   (make-stream (lambda (p)
  237.                  (let ((o (read p)))
  238.                    (or (eof-object? o)
  239.                        (cons o p))))
  240.                port))
  241.  
  242. ;;; streams.scm ends here
  243.